home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 7: Sunsite / Linux Cubed Series 7 - Sunsite Vol 1.iso / system / network / info-sys / www / tkhtml-2.3 / tkhtml-2 / tkHTML-2.3 / files.tcl < prev    next >
Encoding:
Text File  |  1995-02-06  |  7.8 KB  |  380 lines
  1. #############################################
  2. # file manipulation
  3.  
  4. #############################################
  5. # this sets and eventually clears the eetn window
  6.  
  7. proc ClearEvent {message} {
  8.     global event
  9.     set event $message
  10.     after 2500 {set event ""}
  11. }
  12.  
  13. #############################################
  14. # When a user wants a new file, verify that they are sure
  15.  
  16. proc NewFileDlg {} {
  17.     global filename event
  18.  
  19.     ClearEvent "Calling fileselector"
  20.  
  21.     toplevel .new
  22.     wm title .new "New document"
  23.  
  24.     set x [expr 230 + [winfo x .]]
  25.     set y [expr 100 + [winfo y .]]
  26.     wm geometry .new +$x+$y
  27.  
  28.  
  29.     frame .new.top -relief raised -border 1
  30.     message .new.top.msg -relief sunken -bd 1 -anchor n -padx 20 \
  31.         -width 300 -text "Save current?"
  32.     tixDlgBtns .new.btns
  33.     .new.btns add yes -text "Yes, Save" -width 10
  34.     .new.btns add no -text "No Save" -width 10
  35.     .new.btns add cancel -text "Cancel" -width 10
  36.     
  37.     pack .new.top.msg -expand yes -fill both -padx 10 -pady 10
  38.     pack .new.top -expand yes -fill both 
  39.     pack .new.btns -fill x
  40.  
  41.     .new.btns button yes config -command {
  42.         if {[string length $filename] == 0 } {
  43.             SaveFileDlg SaveCmd4
  44.         } else {
  45.             SaveFile
  46.             .textframe.vp.text delete "1.0" "end"
  47.             catch {HtUncache "file://localhost/$filename"}
  48.             set filename ""
  49.             if {$newheader == 1} {
  50.                 Header
  51.             }
  52.             destroy .new
  53.         }
  54.     }
  55.     .new.btns button no config -command {
  56.         destroy .new
  57.         .textframe.vp.text delete "1.0" "end"
  58.         catch {HtUncache "file://localhost/$filename"}
  59.         set filename ""
  60.         if {$newheader == 1} {
  61.             Header
  62.         }
  63.     }
  64.     .new.btns button cancel config -command "destroy .new"    
  65. }
  66.  
  67. #############################################
  68. # Save as dialog
  69.  
  70. proc SaveFileAs {} {
  71.     global filename
  72.     global event
  73.  
  74.     ClearEvent "Calling fileselector"
  75.  
  76.     if {![winfo exists .save]} {
  77.         tixMkFileDialog .save SaveCmd
  78.         set x [expr 230 + [winfo x .]]
  79.         set y [expr 60 + [winfo y .]]
  80.         wm geometry .save +$x+$y
  81.         wm title .save "Save As..."
  82.     } else {
  83.         wm deiconify .save
  84.     }
  85. }
  86.  
  87. #############################################
  88. # File | Save option
  89.  
  90. proc SaveFileDlg {savecommand} {
  91.     global filename
  92.  
  93.     ClearEvent "Calling fileselector"
  94.  
  95.     if {[string length $filename] == 0} {
  96.         if {![winfo exists .save]} {
  97.             tixMkFileDialog .save $savecommand
  98.             set x [expr 230 + [winfo x .]]
  99.             set y [expr 60 + [winfo y .]]
  100.             wm geometry .save +$x+$y
  101.             wm title .save "Save file"
  102.         } else { 
  103.             wm deiconify .save
  104.         }
  105.     } else {
  106.         SaveFile
  107.     }
  108. }
  109.  
  110. #############################################
  111. # Save file
  112.  
  113. proc SaveCmd {filenametmp} {
  114.     global filename
  115.  
  116.     if {[string length $filenametmp] != 0} {
  117.         set filename $filenametmp
  118.         SaveFile
  119.     }
  120. }
  121.  
  122. #############################################
  123. # save file and exit
  124.  
  125. proc SaveCmd2 {filenametmp} {
  126.     global filename
  127.  
  128.     if {[string length $filenametmp] != 0} {
  129.         set filename $filenametmp
  130.         SaveFile
  131.         if {[file exists $tempfile] == 1} {
  132.             catch {exec rm $tempfile}
  133.         }
  134.         destroy .
  135.     }
  136. }
  137.  
  138. #############################################
  139. # save file and open new one
  140.  
  141. proc SaveCmd4 {filenametmp} {
  142.     global filename
  143.     if {[string length $filenametmp] != 0} {
  144.         set filename $filenametmp
  145.         SaveFile
  146.         destroy .new
  147.         .textframe.vp.text delete "1.0" "end"
  148.         catch {HtUncache "file://localhost/$filename"}
  149.         set filename ""
  150.     }
  151. }
  152.  
  153. #############################################
  154. # write the file, called by all SaveCmd's
  155.  
  156. proc SaveFile {} {
  157.     global filename
  158.  
  159.     ClearEvent "Saving file..."
  160.  
  161.     set f [open $filename w]
  162.     set lines [.textframe.vp.text get "1.0" "end"]
  163.     puts $f $lines
  164.     close $f
  165.  
  166.     ClearEvent "File saved."
  167.     
  168. }
  169.  
  170. #############################################
  171. # about tkHTML
  172.  
  173. proc AboutDlg {} {
  174.     global version
  175.     global tkhtmllibdir
  176.  
  177.     ClearEvent "About..."
  178.  
  179.     toplevel .about    
  180.     wm title .about "About tkHTML $version"
  181.  
  182.     set x [expr 230 + [winfo x .]]
  183.     set y [expr 100 + [winfo y .]]
  184.  
  185.     wm geometry .about +$x+$y
  186.     wm title .about "About tkHTML-$version"
  187.  
  188.     frame .about.top -relief raised -bd 1
  189.     # a couple fonts, for fun
  190.  
  191.     label .about.top.msgl \
  192.         -bitmap @$tkhtmllibdir/icon
  193.     text .about.top.msg -relief groove -bd 2 -width 28 -height 8 \
  194.         -background lightgrey -wrap word
  195.  
  196.     ConfigFonts .about.top.msg
  197.  
  198.     insertWithTags .about.top.msg "\n tkHTML $version\n" 180H 
  199.     insertWithTags .about.top.msg " (C)1994 Liem Bahneman\n" normal
  200.     insertWithTags .about.top.msg " roland@cac.washington.edu\n" normali
  201.     insertWithTags .about.top.msg " If you have any questions, gripes or\n comments, please send them to me!\n" normal
  202.     tixDlgBtns .about.btns
  203.     .about.btns add close -text "Close" -width 10
  204.     pack .about.top.msgl -expand yes -fill both -side left \
  205.         -padx 10 -pady 10
  206.     pack .about.top.msg -expand yes -fill both -padx 10 -pady 10 \
  207.         -side right
  208.     pack .about.top -expand yes -fill both
  209.     pack .about.btns -fill x
  210.     .about.top.msg configure -state disabled
  211.  
  212.     .about.btns button close config -command "destroy .about"
  213. }
  214.  
  215. #############################################
  216. # open an existing file
  217.  
  218. proc OpenFileDlg {} {
  219.     global filename
  220.  
  221.     ClearEvent "Calling fileselector"
  222.  
  223.     if {![winfo exists .open]} {
  224.         tixMkFileDialog .open OpenCmd
  225.         set x [expr 230 + [winfo x .]]
  226.         set y [expr 60 + [winfo x .]]
  227.         wm geometry .open +$x+$y
  228.         wm title .open "Open file"
  229.     } else {
  230.         wm deiconify .open
  231.     }
  232.  
  233. }    
  234.  
  235. #############################################
  236. # open the file 
  237.  
  238. proc OpenCmd {filenametmp} {
  239.     global filename
  240.  
  241.     if {[string length $filenametmp] != 0} {
  242.         OpenFile $filenametmp
  243.     }
  244. }
  245.  
  246. #############################################
  247. # open the file from file
  248.  
  249. proc OpenFile {newfile} {
  250.     global filename
  251.  
  252.     ClearEvent "Opening file..."
  253.  
  254.     #catch {HtUncache "file://localhost/$filename"}
  255.     
  256.     set f [open $newfile r]
  257.     set lines [read $f]
  258.  
  259.     .textframe.vp.text delete "1.0" "end"
  260.     .textframe.vp.text insert "1.0" $lines
  261.  
  262.     set filename $newfile
  263.     close $f
  264.     
  265.     ClearEvent "File opened."
  266.     .textframe.vp.text mark set insert 1.0
  267. }
  268.  
  269. #############################################
  270. # if there was a file on the command line, open it
  271.  
  272. proc InitFile {argv} {
  273.     global filename newheader
  274.  
  275.     set newfile1 [lindex $argv 0]
  276.  
  277.     # check if absolute or relative path
  278.     if {[string index $$newfile1 1] == "/"} {
  279.         set newfile2 $newfile1
  280.     } else {
  281.         set pwd [pwd]
  282.         set newfile2 "$pwd/$newfile1"
  283.     }
  284.  
  285.     if {[file exists $newfile2] == 1} {
  286.         OpenFile $newfile2
  287.     } else {
  288.         set filename $newfile2
  289.         if {$newheader == 1} {
  290.             Header
  291.             return
  292.         }
  293.     }
  294.     .textframe.vp.text mark set insert 0.0
  295. }
  296.  
  297. #############################################
  298. # quit, verify save or cancel
  299.  
  300. proc QuitDlg {} {
  301.     global filename tempfile
  302.  
  303.     toplevel .quit
  304.     wm title .quit "Quit tkHTML"
  305.  
  306.     set x [expr 230 + [winfo x .]]
  307.     set y [expr 100 + [winfo y .]]
  308.     wm geometry .quit +$x+$y
  309.  
  310.  
  311.     frame .quit.top -relief raised -border 1
  312.     message .quit.top.msg -relief sunken -bd 1 -anchor n -padx 20 \
  313.         -width 300 -text "Save current?" \
  314.         -font "-adobe-helvetica-bold-r-normal-*-14-*-*-*-*-*-*-*"
  315.     tixDlgBtns .quit.btns
  316.     .quit.btns add yes -text "Yes, Save" -width 10
  317.     .quit.btns add no -text "No Save" -width 10
  318.     .quit.btns add cancel -text "Cancel" -width 10
  319.     
  320.     pack .quit.top.msg -expand yes -fill both -padx 10 -pady 10
  321.     pack .quit.top -expand yes -fill both 
  322.     pack .quit.btns -fill x
  323.  
  324.     .quit.btns button yes config -command {
  325.         if {[string length $filename] == 0 } {
  326.             SaveFileDlg SaveCmd2
  327.         } else {
  328.             SaveFile
  329.             exit
  330.         }
  331.     }
  332.     .quit.btns button no config -command {
  333.         destroy .
  334.         if {[file exists $tempfile] == 1} {
  335.             catch {exec rm $tempfile}
  336.         }
  337.     }
  338.     .quit.btns button cancel config -command "destroy .quit"    
  339. }
  340.  
  341. #############################################
  342. # save file for previewing
  343.  
  344. proc SaveForPreview {} {
  345.     global tempfile
  346.  
  347.     ClearEvent "Saving temp file..."
  348.  
  349.     set f [open $tempfile w]
  350.     set lines [.textframe.vp.text get "1.0" "end"]
  351.     puts $f $lines
  352.     close $f
  353.  
  354.     ClearEvent "File saved."
  355.  
  356.     if {[winfo exists .preview] == 0} {
  357.         Preview "file://localhost/$tempfile"
  358.     } else {
  359.         DoPreview "file://localhost/$tempfile"
  360.     }
  361. }
  362.  
  363.  
  364.  
  365. proc Header {} {
  366.     .textframe.vp.text insert insert \
  367. "<HEAD>
  368. <TITLE></TITLE>
  369. </HEAD>
  370. <BODY>"
  371.  
  372.     #set the cursor in the middle of the <TITLE> tags
  373.     .textframe.vp.text mark set insert 2.7
  374. }
  375.  
  376.  
  377.  
  378.  
  379.  
  380.